home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s3.arc / PROCESSS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-10  |  54.4 KB  |  1,410 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Process_Script --- Convert PibTerm script file to in-core code.    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE Process_Script;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Process_Script                                       *)
  10. (*                                                                      *)
  11. (*     Purpose:    Convert PibTerm script file to in-core instructions. *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*         Process_Script;                                              *)
  16. (*                                                                      *)
  17. (*      Remarks:                                                        *)
  18. (*                                                                      *)
  19. (*         The entire script file is read and converted to an in-core   *)
  20. (*         representation which can be executed.                        *)
  21. (*                                                                      *)
  22. (*         At this time, user-defined labels are not allowed.  There    *)
  23. (*         are some variable related to them here, however.  The next   *)
  24. (*         time around (PibTerm v4.0) they will be used to allow for    *)
  25. (*         case statements and procedures in scripts.                   *)
  26. (*                                                                      *)
  27. (*----------------------------------------------------------------------*)
  28.  
  29. CONST                              (* Maximum # of labels allowed *)
  30.    Max_Script_Labels = 20;
  31.                                    (* Maximum stack depth         *)
  32.    Max_Script_Stack  = 10;
  33.  
  34. TYPE                               
  35.                                    (* Points to a label reference *)
  36.  
  37.    Script_Label_Ptr = ^Script_Label_Reference;
  38.  
  39.                                    (* Records one label reference *)
  40.    Script_Label_Reference = RECORD
  41.                                                (* Offset in script buffer *)
  42.                                Buffer_Pos : INTEGER;
  43.                                                (* Next reference *)
  44.                                Next_Ref   : Script_Label_Ptr;
  45.  
  46.                             END;
  47.  
  48.    Script_Label_Type = RECORD
  49.                                           (* Label name *)
  50.                           Name       : STRING[12];
  51.                                           (* Label definition position *)
  52.                           Buffer_Pos : INTEGER;
  53.                                           (* Pointer to first reference *)
  54.                           First_Ref  : Script_Label_Ptr;
  55.  
  56.                        END;
  57.  
  58. VAR
  59.                                    (* Number of labels currently defined *)
  60.  
  61.    Script_Label_Count     : INTEGER;
  62.  
  63.                                    (* Script label definition vector *)
  64.  
  65.    Script_Labels          : ARRAY[1..Max_Script_Labels] OF Script_Label_Type;
  66.  
  67.                                    (* Current stack levels, conditional     *)
  68.                                    (* script commands.                      *)
  69.  
  70.    Script_Repeat_Level    : INTEGER;
  71.    Script_If_Level        : INTEGER;
  72.    Script_While_Level     : INTEGER;
  73.  
  74.                                    (* Stacks for conditional commands       *)
  75.  
  76.    Script_Repeat_Stack    : ARRAY[1..Max_Script_Stack] OF INTEGER;
  77.    Script_If_Stack        : ARRAY[1..Max_Script_Stack] OF INTEGER;
  78.    Script_While_Stack     : ARRAY[1..Max_Script_Stack] OF INTEGER;
  79.  
  80.    L                      : INTEGER;
  81.    I                      : INTEGER;
  82.    K                      : INTEGER;
  83.    IS                     : INTEGER;
  84.    Local_Save             : Saved_Screen_Ptr;
  85.    Ch                     : CHAR;
  86.    Text_Line              : AnyStr;
  87.    Byte_File              : FILE OF BYTE;
  88.    OK_Script_Command      : BOOLEAN;
  89.    Script_Command_Token   : AnyStr;
  90.    Script_Line            : AnyStr;
  91.    Saved_Script_Line      : AnyStr;
  92.    Current_Script_Command : PibTerm_Command_Type;
  93.  
  94.    Script_Debug_File      : TEXT;
  95.    Script_Debug_Mode      : BOOLEAN;
  96.  
  97. (*----------------------------------------------------------------------*)
  98. (*             Get_Quoted_String --- pick up string in quotes           *)
  99. (*----------------------------------------------------------------------*)
  100.  
  101. PROCEDURE Get_Quoted_String(     S    : AnyStr;
  102.                              VAR IS   : INTEGER;
  103.                              VAR QS   : AnyStr;
  104.                              VAR Quote: CHAR );
  105.  
  106. (*----------------------------------------------------------------------*)
  107. (*                                                                      *)
  108. (*     Procedure:  Get_Quoted_String                                    *)
  109. (*                                                                      *)
  110. (*     Purpose:    Extracts quoted string from a string.                *)
  111. (*                                                                      *)
  112. (*     Calling Sequence:                                                *)
  113. (*                                                                      *)
  114. (*        Get_Quoted_String(      S    : AnyStr;                        *)
  115. (*                           VAR IS    : INTEGER;                       *)
  116. (*                           VAR QS    : AnyStr;                        *)
  117. (*                           VAR Quote : CHAR );                        *)
  118. (*                                                                      *)
  119. (*            S     --- string containing quoted string                 *)
  120. (*            IS    --- current position in S                           *)
  121. (*            QS    --- resultant extracted string (no quotes)          *)
  122. (*            Quote --- quote character (blank if quotes not found)     *)
  123. (*                                                                      *)
  124. (*      Remarks:                                                        *)
  125. (*                                                                      *)
  126. (*         A quote within a string can be entered by putting two quotes *)
  127. (*         together, e.g., 'ab''c' -->  ab'c.                           *)
  128. (*                                                                      *)
  129. (*----------------------------------------------------------------------*)
  130.  
  131. VAR
  132.    LS         : INTEGER;
  133.    End_String : BOOLEAN;
  134.  
  135. BEGIN (* Get_Quoted_String *)
  136.                                    (* Null string is default *)
  137.    QS    := '';
  138.    Quote := ' ';
  139.                                    (* Skip leading blanks *)
  140.    LS    := LENGTH( S );
  141.  
  142.    WHILE ( IS <= LS ) AND ( S[IS] = ' ' ) DO
  143.       IS := IS + 1;
  144.                                    (* See if we have a quote *)
  145.    IF ( IS <= LS ) THEN
  146.       BEGIN
  147.  
  148.          IF S[IS] IN ['''','"'] THEN
  149.             BEGIN
  150.                                    (* Pickup quoted string is so *)
  151.                Quote      := S[IS];
  152.                End_String := FALSE;
  153.  
  154.                REPEAT
  155.  
  156.                   IS := IS + 1;
  157.                                    (* Note:  two quotes in a row used   *)
  158.                                    (*        to indicate single quote   *)
  159.                                    (*        to be inserted into string *)
  160.  
  161.                   IF IS <= LS THEN
  162.                      IF S[IS] <> Quote THEN
  163.                         QS := QS + S[IS]
  164.                      ELSE
  165.                         BEGIN
  166.                            IF ( IS + 1 ) <= LS THEN
  167.                               IF S[IS+1] = Quote THEN
  168.                                  BEGIN
  169.                                     QS := QS + Quote;
  170.                                     IS := IS + 1;
  171.                                  END
  172.                               ELSE
  173.                                  End_String := TRUE
  174.                            ELSE
  175.                               End_String := TRUE;
  176.                         END
  177.                   ELSE
  178.                      End_String := TRUE;
  179.  
  180.                UNTIL End_String;
  181.  
  182.             END;
  183.  
  184.       END;
  185.  
  186. END   (* Get_Quoted_String *);
  187.  
  188. (*----------------------------------------------------------------------*)
  189. (*                     Get_String --- Pick up string                    *)
  190. (*----------------------------------------------------------------------*)
  191.  
  192. PROCEDURE Get_String(     S    : AnyStr;
  193.                       VAR IS   : INTEGER;
  194.                       VAR QS   : AnyStr;
  195.                       VAR Delim: CHAR );
  196.  
  197. (*----------------------------------------------------------------------*)
  198. (*                                                                      *)
  199. (*     Procedure:  Get_String                                           *)
  200. (*                                                                      *)
  201. (*     Purpose:    Extracts string up to a delimeter.                   *)
  202. (*                                                                      *)
  203. (*     Calling Sequence:                                                *)
  204. (*                                                                      *)
  205. (*        Get_String(      S     : AnyStr;                              *)
  206. (*                     VAR IS    : INTEGER;                             *)
  207. (*                     VAR QS    : AnyStr;                              *)
  208. (*                     VAR Delim : CHAR );                              *)
  209. (*                                                                      *)
  210. (*            S     --- string containing string to extract             *)
  211. (*            IS    --- current position in S                           *)
  212. (*            QS    --- resultant extracted string                      *)
  213. (*            Delim --- delimeter character                             *)
  214. (*                                                                      *)
  215. (*----------------------------------------------------------------------*)
  216.  
  217. VAR
  218.    LS         : INTEGER;
  219.    End_String : BOOLEAN;
  220.    Ch         : CHAR;
  221.  
  222. BEGIN (* Get_String *)
  223.                                    (* Null string is default *)
  224.    QS    := '';
  225.    Delim := ' ';
  226.                                    (* Skip leading blanks *)
  227.    LS    := LENGTH( S );
  228.  
  229.    WHILE ( IS <= LS ) AND ( S[IS] = ' ' ) DO
  230.       IS := IS + 1;
  231.                                    (* Copy up to non-letter, non-digit *)
  232.    End_String := FALSE;
  233.  
  234.    IF ( IS <= LS ) THEN
  235.       REPEAT
  236.  
  237.          Ch := S[IS];
  238.  
  239.          IF ( Ch IN ['A'..'Z','a'..'z','0'..'9'] ) THEN
  240.             BEGIN
  241.                QS := QS + Ch;
  242.                IS := IS + 1;
  243.             END
  244.          ELSE
  245.             BEGIN
  246.                End_String := TRUE;
  247.                Delim      := Ch;
  248.             END;
  249.  
  250.       UNTIL End_String;
  251.  
  252. END   (* Get_String *);
  253.  
  254. (*----------------------------------------------------------------------*)
  255. (*                  Get_Integer --- pick up integer                     *)
  256. (*----------------------------------------------------------------------*)
  257.  
  258. PROCEDURE Get_Integer(     S     : AnyStr;
  259.                        VAR IS    : INTEGER;
  260.                        VAR Qnum  : BOOLEAN;
  261.                        VAR IntVal: INTEGER );
  262.  
  263. (*----------------------------------------------------------------------*)
  264. (*                                                                      *)
  265. (*     Procedure:  Get_Integer                                          *)
  266. (*                                                                      *)
  267. (*     Purpose:    Extracts integer from a string.                      *)
  268. (*                                                                      *)
  269. (*     Calling Sequence:                                                *)
  270. (*                                                                      *)
  271. (*        Get_Integer(      S      : AnyStr;                            *)
  272. (*                      VAR IS     : INTEGER;                           *)
  273. (*                      VAR Qnum   : BOOLEAN;                           *)
  274. (*                      VAR IntVal : INTEGER   );                       *)
  275. (*                                                                      *)
  276. (*            S      --- string containing quoted string                *)
  277. (*            IS     --- current position in S                          *)
  278. (*            Qnum   --- TRUE if a number extracted                     *)
  279. (*            IntVal --- integer extracted or 0 if none                 *)
  280. (*                                                                      *)
  281. (*----------------------------------------------------------------------*)
  282.  
  283. VAR
  284.    LS         : INTEGER;
  285.    End_Of_Num : BOOLEAN;
  286.    Int_Sign   : INTEGER;
  287.  
  288. BEGIN (* Get_Integer *)
  289.                                    (* Skip leading blanks *)
  290.    LS     := LENGTH( S );
  291.  
  292.    WHILE ( IS <= LS ) AND ( S[IS] = ' ' ) DO
  293.       IS := IS + 1;
  294.                                    (* Default value is zero *)
  295.    IntVal     := 0;
  296.    Qnum       := FALSE;
  297.    End_Of_Num := FALSE;
  298.    Int_Sign   := 1;
  299.                                    (* Pick up minus sign    *)
  300.    IF ( IS <= LS ) THEN
  301.       IF ( S[IS] = '-' ) THEN
  302.          BEGIN
  303.             Int_Sign := -1;
  304.             IS       := IS + 1;
  305.          END;
  306.                                    (* Pick up digits if any *)
  307.    REPEAT
  308.  
  309.       IF ( IS <= LS ) THEN
  310.          IF S[IS] IN ['0'..'9'] THEN
  311.             BEGIN
  312.                IntVal := IntVal * 10 + ORD( S[IS] ) - ORD('0');
  313.                Qnum   := TRUE;
  314.             END
  315.          ELSE
  316.             End_Of_Num := TRUE
  317.       ELSE
  318.          End_Of_Num := TRUE;
  319.  
  320.       IF ( NOT End_Of_Num ) THEN
  321.          IS := IS + 1;
  322.  
  323.    UNTIL ( End_Of_Num );
  324.  
  325.    IntVal := IntVal * Int_Sign;
  326.  
  327. END   (* Get_Integer *);
  328.  
  329. (*----------------------------------------------------------------------*)
  330. (*    Copy_String_To_Buffer --- Copy string from script line to buffer  *)
  331. (*----------------------------------------------------------------------*)
  332.  
  333. PROCEDURE Copy_String_To_Buffer;
  334.  
  335. (*----------------------------------------------------------------------*)
  336. (*                                                                      *)
  337. (*     Procedure:  Copy_String_To_Buffer                                *)
  338. (*                                                                      *)
  339. (*     Purpose:    Copies quoted string from script line to buffer      *)
  340. (*                                                                      *)
  341. (*     Calling Sequence:                                                *)
  342. (*                                                                      *)
  343. (*        Copy_String_To_Buffer;                                        *)
  344. (*                                                                      *)
  345. (*----------------------------------------------------------------------*)
  346.  
  347. VAR
  348.    L     : INTEGER;
  349.    Quote : CHAR;
  350.    I     : INTEGER;
  351.  
  352. BEGIN (* Copy_String_To_Buffer *)
  353.  
  354.    Get_Quoted_String( Script_Line, IS, Text_Line, Quote );
  355.  
  356.    L := LENGTH( Text_Line );
  357.  
  358.    IF ( NOT ( Quote IN ['''','"'] ) ) THEN
  359.       L := 0;
  360.  
  361.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  362.    Script_Buffer^[Script_Buffer_Pos] := L;
  363.  
  364.    IF Script_Debug_Mode THEN
  365.        WRITE( Script_Debug_File , Script_Buffer_Pos:4 , ' ', L:4 );
  366.  
  367.    FOR I := 1 TO L DO
  368.       BEGIN
  369.          Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  370.          Script_Buffer^[Script_Buffer_Pos] := ORD( Text_Line[I] );
  371.       END;
  372.  
  373.    IF Script_Debug_Mode THEN
  374.        BEGIN
  375.           WRITE  ( Script_Debug_File , ' ', Text_Line );
  376.           WRITELN( Script_Debug_File );
  377.        END;
  378.  
  379. END   (* Copy_String_To_Buffer *);
  380.  
  381. (*----------------------------------------------------------------------*)
  382. (*     Copy_Integer_To_Buffer --- Copy integer to script line buffer    *)
  383. (*----------------------------------------------------------------------*)
  384.  
  385. PROCEDURE Copy_Integer_To_Buffer( IntVal : INTEGER );
  386.  
  387. (*----------------------------------------------------------------------*)
  388. (*                                                                      *)
  389. (*     Procedure:  Copy_Integer_To_Buffer                               *)
  390. (*                                                                      *)
  391. (*     Purpose:    Copies integer to script line buffer                 *)
  392. (*                                                                      *)
  393. (*     Calling Sequence:                                                *)
  394. (*                                                                      *)
  395. (*        Copy_Integer_To_Buffer( IntVal : INTEGER );                   *)
  396. (*                                                                      *)
  397. (*           IntVal --- Value to place in script buffer                 *)
  398. (*                                                                      *)
  399. (*----------------------------------------------------------------------*)
  400.  
  401. VAR
  402.    Int_Bytes : ARRAY[1..2] OF BYTE ABSOLUTE IntVal;
  403.  
  404. BEGIN (* Copy_Integer_To_Buffer *)
  405.  
  406.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  407.    Script_Buffer^[Script_Buffer_Pos] := Int_Bytes[1];
  408.  
  409.    IF Script_Debug_Mode THEN
  410.        WRITELN( Script_Debug_File , Script_Buffer_Pos:4 , ' ',
  411.                 Int_Bytes[1]:4, Int_Bytes[2]:4, ' ', IntVal:8,
  412.                 ' (Integer)');
  413.  
  414.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  415.    Script_Buffer^[Script_Buffer_Pos] := Int_Bytes[2];
  416.  
  417. END   (* Copy_Integer_To_Buffer *);
  418.  
  419. (*----------------------------------------------------------------------*)
  420. (*        Copy_Byte_To_Buffer --- Copy byte to script line buffer       *)
  421. (*----------------------------------------------------------------------*)
  422.  
  423. PROCEDURE Copy_Byte_To_Buffer( ByteVal : INTEGER );
  424.  
  425. (*----------------------------------------------------------------------*)
  426. (*                                                                      *)
  427. (*     Procedure:  Copy_Byte_To_Buffer                                  *)
  428. (*                                                                      *)
  429. (*     Purpose:    Copies byte to script line buffer                    *)
  430. (*                                                                      *)
  431. (*     Calling Sequence:                                                *)
  432. (*                                                                      *)
  433. (*        Copy_Byte_To_Buffer( IntVal : INTEGER );                      *)
  434. (*                                                                      *)
  435. (*           ByteVal --- Value to place in script buffer                *)
  436. (*                                                                      *)
  437. (*----------------------------------------------------------------------*)
  438.  
  439. BEGIN (* Copy_Byte_To_Buffer *)
  440.  
  441.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  442.    Script_Buffer^[Script_Buffer_Pos] := ByteVal;
  443.  
  444.    IF Script_Debug_Mode THEN
  445.        BEGIN
  446.           WRITE( Script_Debug_File , Script_Buffer_Pos:4 , ' ', ByteVal,
  447.                  ' (Byte)' );
  448.           IF ( ByteVal > 32 ) AND ( ByteVal < 127 ) THEN
  449.              WRITE( Script_Debug_File , ' (',CHR( ByteVal ),')' );
  450.           WRITELN( Script_Debug_File );
  451.        END;
  452.  
  453. END   (* Copy_Integer_To_Buffer *);
  454.  
  455. (*----------------------------------------------------------------------*)
  456. (*    Copy_Protocol_To_Buffer --- Copy transfer protocol to buffer      *)
  457. (*----------------------------------------------------------------------*)
  458.  
  459. PROCEDURE Copy_Protocol_To_Buffer;
  460.  
  461. (*----------------------------------------------------------------------*)
  462. (*                                                                      *)
  463. (*     Procedure:  Copy_Protocol_To_Buffer                              *)
  464. (*                                                                      *)
  465. (*     Purpose:    Copies file transfer protocol to buffer              *)
  466. (*                                                                      *)
  467. (*     Calling Sequence:                                                *)
  468. (*                                                                      *)
  469. (*        Copy_Protocol_To_Buffer;                                      *)
  470. (*                                                                      *)
  471. (*----------------------------------------------------------------------*)
  472.  
  473. VAR
  474.    LS                : INTEGER;
  475.    Transfer_Protocol : Transfer_Type;
  476.    Trans_Mode        : STRING[10];
  477.    End_Of_Protocol   : BOOLEAN;
  478.    Delim             : CHAR;
  479.  
  480. BEGIN (* Copy_Protocol_To_Buffer *)
  481.  
  482.                                    (* Get transfer mode *)
  483.  
  484.    Get_String( Script_Line, IS, Trans_Mode, Delim );
  485.  
  486.    IF LENGTH( Trans_Mode ) > 0 THEN
  487.       Trans_Mode := UpperCase( Trans_Mode )
  488.    ELSE
  489.       Trans_Mode := 'Z';
  490.  
  491.    Transfer_Protocol := Default_Transfer_Type;
  492.  
  493.    IF Trans_Mode = 'A'  THEN
  494.       Transfer_Protocol := Ascii
  495.    ELSE IF Trans_Mode = 'X'  THEN
  496.       Transfer_Protocol := Xmodem_Chk
  497.    ELSE IF Trans_Mode = 'XC' THEN
  498.       Transfer_Protocol := Xmodem_CRC
  499.    ELSE IF Trans_Mode = 'Y'  THEN
  500.       Transfer_Protocol := Ymodem
  501.    ELSE IF Trans_Mode = 'YB' THEN
  502.       Transfer_Protocol := Ymodem_Batch
  503.    ELSE IF Trans_Mode = 'T'  THEN
  504.       Transfer_Protocol := Telink
  505.    ELSE IF Trans_Mode = 'TC' THEN
  506.       Transfer_Protocol := Telink
  507.    ELSE IF Trans_Mode = 'M'  THEN
  508.        Transfer_Protocol := Modem7_Chk
  509.    ELSE IF Trans_Mode = 'MC'  THEN
  510.        Transfer_Protocol := Modem7_CRC
  511.    ELSE IF Trans_Mode = 'M7' THEN
  512.       Transfer_Protocol := Modem7_CRC
  513.    ELSE IF Trans_Mode = 'K' THEN
  514.          BEGIN
  515.             Transfer_Protocol    := Kermit;
  516.             Kermit_File_Type_Var := Kermit_Ascii;
  517.          END
  518.       ELSE IF Trans_Mode = 'KB' THEN
  519.          BEGIN
  520.             Transfer_Protocol    := Kermit;
  521.             Kermit_File_Type_Var := Kermit_Binary;
  522.          END;
  523.  
  524.    Copy_Integer_To_Buffer( ORD( Transfer_Protocol ) + 1 );
  525.  
  526. END   (* Copy_Protocol_To_Buffer *);
  527.  
  528. (*----------------------------------------------------------------------*)
  529. (*    Extract_Script_Command --- Extract command type from script line  *)
  530. (*----------------------------------------------------------------------*)
  531.  
  532. PROCEDURE Extract_Script_Command( VAR OK_Script_Command : BOOLEAN );
  533.  
  534. (*----------------------------------------------------------------------*)
  535. (*                                                                      *)
  536. (*     Procedure:  Extract_Script_Command                               *)
  537. (*                                                                      *)
  538. (*     Purpose:    Extracts command name from script line               *)
  539. (*                                                                      *)
  540. (*     Calling Sequence:                                                *)
  541. (*                                                                      *)
  542. (*        Extract_Script_Command( VAR OK_Script_Command : BOOLEAN );    *)
  543. (*                                                                      *)
  544. (*           OK_Script_Command --- set TRUE if legitimate command       *)
  545. (*                                                                      *)
  546. (*----------------------------------------------------------------------*)
  547.  
  548. VAR
  549.    Found : BOOLEAN;
  550.    L     : INTEGER;
  551.  
  552. BEGIN (* Extract_Script_Command *)
  553.  
  554.                                    (* Remove initial, trailing blanks *)
  555.  
  556.    Script_Line := LTRIM( TRIM( Script_Line ) );
  557.    L           := LENGTH( Script_Line );
  558.  
  559.                                    (* If nothing left, ignore this line *)
  560.  
  561.    IF ( L < 1 ) THEN
  562.       Current_Script_Command := Null_Command
  563.    ELSE
  564.       BEGIN
  565.                                    (* Append blank to script line *)
  566.  
  567.          Script_Line := Script_Line + ' ';
  568.  
  569.                                    (* Pick up command name        *)
  570.  
  571.          Script_Command_Token := '';
  572.          I                    := 1;
  573.  
  574.          WHILE( Script_Line[I] <> ' ' ) DO
  575.             BEGIN
  576.                Script_Command_Token := Script_Command_Token +
  577.                                        UpCase( Script_Line[I] );
  578.                I                    := I + 1;
  579.             END;
  580.                                     (* Abbreviate command to 8 chars *)
  581.  
  582.          IF ( LENGTH( Script_Command_Token ) > 8 ) THEN
  583.             Script_Command_Token := COPY( Script_Command_Token, 1, 8 );
  584.  
  585.                                     (* Strip command text from front *)
  586.                                     (* of script text line           *)
  587.          I := I + 1;
  588.  
  589.          IF ( L - I + 1 ) > 0 THEN
  590.             Script_Line := COPY( Script_Line, I, L - I + 1 )
  591.          ELSE
  592.             Script_Line := '';
  593.  
  594.                                    (* Look up command in valid command list *)
  595.          I     := 0;
  596.          Found := FALSE;
  597.  
  598.          REPEAT
  599.             I     := I + 1;
  600.             Found := ( Script_Command_Token = Script_File_Command_Names[I] );
  601.          UNTIL  ( Found OR ( I >= Max_Script_File_Commands ) );
  602.  
  603.          IF ( NOT Found ) THEN
  604.             Current_Script_Command := Bad_Command
  605.          ELSE
  606.             Current_Script_Command := Script_File_Commands[I];
  607.  
  608.       END;
  609.  
  610.    OK_Script_Command := Current_Script_Command <> Bad_Command;
  611.  
  612. END   (* Extract_Script_Command *);
  613.  
  614. (*----------------------------------------------------------------------*)
  615. (*      Emit_Wait_String_Command --- Emit wait for string command       *)
  616. (*----------------------------------------------------------------------*)
  617.  
  618. PROCEDURE Emit_Wait_String_Command( VAR OK_Script_Command: BOOLEAN );
  619.  
  620. (*----------------------------------------------------------------------*)
  621. (*                                                                      *)
  622. (*     Procedure:  Emit_Wait_String_Command                             *)
  623. (*                                                                      *)
  624. (*     Purpose:    Emit command to wait for specified string            *)
  625. (*                                                                      *)
  626. (*     Calling Sequence:                                                *)
  627. (*                                                                      *)
  628. (*        Emit_Wait_String_Command( VAR OK_Script_Command : BOOLEAN );  *)
  629. (*                                                                      *)
  630. (*----------------------------------------------------------------------*)
  631.  
  632. VAR
  633.    Qnum   : BOOLEAN;
  634.    IntVal : INTEGER;
  635.  
  636. BEGIN (* Emit_Wait_String_Command *)
  637.  
  638.                                    (* String to wait for *)
  639.    Copy_String_To_Buffer;
  640.                                    (* Null reply string  *)
  641.  
  642.    Copy_Byte_To_Buffer( 0 );
  643.                                    (* Number of seconds to wait *)
  644.    IS := IS + 1;
  645.  
  646.    Get_Integer( Script_Line, IS, Qnum, IntVal );
  647.  
  648.    IF ( NOT Qnum ) THEN
  649.       IntVal := 30;
  650.  
  651.    Copy_Integer_To_Buffer( IntVal );
  652.  
  653.                                    (* Failure label *)
  654.  
  655.    Copy_Integer_To_Buffer( Script_Buffer_Pos + 3 );
  656.  
  657.    OK_Script_Command := TRUE;
  658.  
  659. END   (* Emit_Wait_String_Command *);
  660.  
  661. (*----------------------------------------------------------------------*)
  662. (*           Emit_If_Command --- Emit IF conditional command            *)
  663. (*----------------------------------------------------------------------*)
  664.  
  665. PROCEDURE Emit_If_Command(     False_Label       : INTEGER;
  666.                            VAR OK_Script_Command : BOOLEAN );
  667.  
  668. (*----------------------------------------------------------------------*)
  669. (*                                                                      *)
  670. (*     Procedure:  Emit_If_Command                                      *)
  671. (*                                                                      *)
  672. (*     Purpose:    Emit IF conditional command                          *)
  673. (*                                                                      *)
  674. (*     Calling Sequence:                                                *)
  675. (*                                                                      *)
  676. (*        Emit_If_Command(     False_Label       : INTEGER;             *)
  677. (*                         VAR OK_Script_Command : BOOLEAN );           *)
  678. (*                                                                      *)
  679. (*----------------------------------------------------------------------*)
  680.  
  681. VAR
  682.    Qnum   : BOOLEAN;
  683.    IntVal : INTEGER;
  684.    PStr   : AnyStr;
  685.    I      : INTEGER;
  686.    L      : INTEGER;
  687.    Delim  : CHAR;
  688.    Save_IS: INTEGER;
  689.  
  690.    NextP      : INTEGER;
  691.    NextP_Bytes: ARRAY[1..2] OF BYTE ABSOLUTE NextP;
  692.  
  693. BEGIN (* Emit_If_Command *)
  694.                                    (* Back up 1 byte in script buffer   *)
  695.                                    (* We overwrite existing instruction *)
  696.                                    (* with the proper IF guy here.      *)
  697.  
  698.    Script_Buffer_Pos := Script_Buffer_Pos - 1;
  699.  
  700.                                    (* Pick up type of condition *)
  701.  
  702.    Get_String( Script_Line, IS, PStr, Delim );
  703.  
  704.    L    := LENGTH( PStr );
  705.    PStr := UpperCase( PStr );
  706.                                    (* No condition -- bad *)
  707.    IF ( L = 0 ) THEN
  708.       BEGIN
  709.          PStr := 'BAD';
  710.          L    := 3;
  711.       END;
  712.                                    (* Look for NOT *)
  713.  
  714.    IF ( PStr = 'NOT' ) THEN
  715.       BEGIN
  716.  
  717.          I := 0;
  718.  
  719.          Get_String( Script_Line, IS, PStr, Delim );
  720.  
  721.          IS   := IS + 1;
  722.  
  723.          L    := LENGTH( PStr );
  724.          PStr := UpperCase( PStr );
  725.  
  726.       END
  727.    ELSE
  728.       I := 1;
  729.                                    (* True branch -- next statement *)
  730.  
  731.    NextP := Script_Buffer_Pos + 8;
  732.  
  733.                                    (* Analyze condition type *)
  734.    IF ( L >= 3 ) THEN
  735.       IF COPY( PStr, 1, 3 ) = 'CON' THEN
  736.          BEGIN
  737.             Copy_Byte_To_Buffer( ORD( IfConSy ) );
  738.             Copy_Integer_To_Buffer( I );
  739.             Copy_Integer_To_Buffer( NextP );
  740.             Copy_Integer_To_Buffer( False_Label );
  741.          END
  742.       ELSE IF COPY( PStr, 1, 3 ) = 'WAI' THEN
  743.          BEGIN
  744.             Copy_Byte_To_Buffer( ORD( IfFoundSy ) );
  745.             Copy_Integer_To_Buffer( I );
  746.             Copy_Integer_To_Buffer( NextP );
  747.             Copy_Integer_To_Buffer( False_Label );
  748.          END
  749.       ELSE IF COPY( PStr, 1, 3 ) = 'LOC' THEN
  750.          BEGIN
  751.             Save_IS := IS;
  752.             Get_Quoted_String( Script_Line, IS, PStr, Delim );
  753.             L := LENGTH( PStr );
  754.             IF ( NOT ( Delim IN ['''','"'] ) ) THEN
  755.                L := 0;
  756.             Copy_Byte_To_Buffer( ORD( IfLocStrSy ) );
  757.             Copy_Integer_To_Buffer( I );
  758.             Copy_Integer_To_Buffer( NextP + L + 1 );
  759.             Copy_Integer_To_Buffer( False_Label );
  760.             IS := Save_IS;
  761.             Copy_String_To_Buffer;
  762.          END
  763.       ELSE IF COPY( PStr, 1, 3 ) = 'REM' THEN
  764.          BEGIN
  765.             Save_IS := IS;
  766.             Get_Quoted_String( Script_Line, IS, PStr, Delim );
  767.             L := LENGTH( PStr );
  768.             IF ( NOT ( Delim IN ['''','"'] ) ) THEN
  769.                L := 0;
  770.             Copy_Byte_To_Buffer( ORD( IfRemStrSy ) );
  771.             Copy_Integer_To_Buffer( I );
  772.             Copy_Integer_To_Buffer( NextP + L + 1 );
  773.             Copy_Integer_To_Buffer( False_Label );
  774.             IS := Save_IS;
  775.             Copy_String_To_Buffer;
  776.          END
  777.       ELSE
  778.          OK_Script_Command := FALSE
  779.    ELSE
  780.       OK_Script_Command := FALSE;
  781.  
  782. END   (* Emit_If_Command *);
  783.  
  784. (*----------------------------------------------------------------------*)
  785. (*   Parse_Script_Command --- Parse and convert script to internal code *)
  786. (*----------------------------------------------------------------------*)
  787.  
  788. PROCEDURE Parse_Script_Command( VAR OK_Script_Command : BOOLEAN );
  789.  
  790. (*----------------------------------------------------------------------*)
  791. (*                                                                      *)
  792. (*     Procedure:  Parse_Script_Command                                 *)
  793. (*                                                                      *)
  794. (*     Purpose:    Parse and convert script line to internal code.      *)
  795. (*                                                                      *)
  796. (*     Calling Sequence:                                                *)
  797. (*                                                                      *)
  798. (*        Parse_Script_Command( VAR OK_Script_Command : BOOLEAN );      *)
  799. (*                                                                      *)
  800. (*           OK_Script_Command --- set TRUE if legitimate command       *)
  801. (*                                                                      *)
  802. (*----------------------------------------------------------------------*)
  803.  
  804. VAR
  805.    Qnum   : BOOLEAN;
  806.    IntVal : INTEGER;
  807.    ByteVal: BYTE;
  808.    Quote  : CHAR;
  809.    Delim  : CHAR;
  810.    L      : INTEGER;
  811.    I      : INTEGER;
  812.    J      : INTEGER;
  813.    SvPos  : INTEGER;
  814.    PStr   : AnyStr;
  815.  
  816.    NextP      : INTEGER;
  817.    NextP_Bytes: ARRAY[1..2] OF BYTE ABSOLUTE NextP;
  818.  
  819. BEGIN (* Parse_Script_Command *)
  820.                                    (* Assume command is OK to start   *)
  821.    OK_Script_Command := TRUE;
  822.                                    (* Insert command type into buffer *)
  823.  
  824.    Copy_Byte_To_Buffer( ORD( Current_Script_Command ) );
  825.  
  826.                                    (* Pick up and insert command-dependent *)
  827.                                    (* information into script buffer.      *)
  828.    IS := 1;
  829.  
  830.    CASE Current_Script_Command OF
  831.  
  832.       SuspendSy,
  833.       DelaySy    : BEGIN
  834.                       Get_Integer( Script_Line, IS, Qnum, IntVal );
  835.                       IF ( NOT Qnum ) THEN
  836.                          IntVal := 1;
  837.                       Copy_Integer_To_Buffer( IntVal );
  838.                    END;
  839.  
  840.       CaptureSy  : BEGIN
  841.                       Copy_String_To_Buffer;
  842.                       IS := IS + 1;
  843.                       Copy_String_To_Buffer;
  844.                    END;
  845.  
  846.       DialSy,
  847.       DosSy,
  848.       InputSy,
  849.       KeySy,
  850.       MessageSy,
  851.       RedialSy,
  852.       STextSy,
  853.       TextSy,
  854.       TranslateSy,
  855.       WaitSy     : Copy_String_To_Buffer;
  856.  
  857.       RInputSy   : BEGIN
  858.                                    (* Copy prompt string to script buffer *)
  859.  
  860.                       Copy_String_To_Buffer;
  861.  
  862.                                    (* Assume echo mode *)
  863.                       I := 1;
  864.                                    (* See if NOECHO appears *)
  865.  
  866.                       Get_String( Script_Line, IS, PStr, Delim );
  867.  
  868.                       PStr := UpperCase( PStr );
  869.  
  870.                       IF ( Pstr = 'NOECHO' ) THEN
  871.                          I := 0;
  872.  
  873.                                    (* Insert echo/noecho flag in buffer *)
  874.  
  875.                       Copy_Integer_To_Buffer( I );
  876.  
  877.                    END;
  878.  
  879.       IfLocStrSy : BEGIN
  880.                                    (* Increment IF level *)
  881.  
  882.                       Script_If_Level := Script_If_Level + 1;
  883.                       Script_If_Stack[Script_If_Level] :=
  884.                          -Script_Buffer_Pos;
  885.  
  886.                                    (* Emit a conditional *)
  887.  
  888.                       Emit_If_Command( 0 , OK_Script_Command );
  889.  
  890.                    END;
  891.  
  892.       ElseSy     : BEGIN
  893.                       IF ( Script_If_Level > 0 ) THEN
  894.                          BEGIN
  895.  
  896.                                    (* Get address of IF statement *)
  897.                                    (* Remember offset is negative *)
  898.  
  899.                             J := -Script_If_Stack[ Script_If_Level ];
  900.  
  901.                                    (* Back up over Else *)
  902.  
  903.                             Script_Buffer_Pos := Script_Buffer_Pos - 1;
  904.  
  905.                                    (* Insert GOTO here to branch  *)
  906.                                    (* around FALSE code.          *)
  907.  
  908.                             Copy_Byte_To_Buffer( ORD( GoToSy ) );
  909.  
  910.                                    (* Address of GoTo not defined   *)
  911.                                    (* since we don't know it yet -- *)
  912.                                    (* leave it zero, and stuff the  *)
  913.                                    (* address of cell to receive    *)
  914.                                    (* fixup address later on IF     *)
  915.                                    (* stack.                        *)
  916.  
  917.                             Script_If_Stack[ Script_If_Level ] :=
  918.                                Script_Buffer_Pos + 1;
  919.  
  920.                             Copy_Integer_To_Buffer( 0 );
  921.  
  922.                                    (* Fixup FALSE branch address in IF *)
  923.  
  924.                             NextP := Script_Buffer_Pos + 1;
  925.  
  926.                             Script_Buffer^[ J + 5 ] := NextP_Bytes[1];
  927.                             Script_Buffer^[ J + 6 ] := NextP_Bytes[2];
  928.  
  929.                             IF Script_Debug_Mode THEN
  930.                                BEGIN
  931.                                   WRITELN( Script_Debug_File ,
  932.                                            '      Fixup at ', ( J + 5 ):4,
  933.                                            ' to be ',NextP_Bytes[1]:4,
  934.                                           NextP_Bytes[2]:4, ' = ',NextP:8 );
  935.                                END;
  936.  
  937.                          END
  938.                       ELSE
  939.                          OK_Script_Command := FALSE;
  940.  
  941.                    END;
  942.  
  943.       EndIfSy    : BEGIN
  944.  
  945.                       IF ( Script_If_Level > 0 ) THEN
  946.                          BEGIN
  947.  
  948.                             J := Script_If_Stack[ Script_If_Level ];
  949.                             Script_If_Level := Script_If_Level - 1;
  950.  
  951.                                    (* Fixup GoTo before ELSE or   *)
  952.                                    (* FALSE branch in original IF *)
  953.                                    (* if no else.                 *)
  954.  
  955.                             NextP := Script_Buffer_Pos;
  956.  
  957.                             IF ( J > 0 ) THEN
  958.                                BEGIN
  959.                                   Script_Buffer^[ J     ] := NextP_Bytes[1];
  960.                                   Script_Buffer^[ J + 1 ] := NextP_Bytes[2];
  961.                                   IF Script_Debug_Mode THEN
  962.                                      BEGIN
  963.                                         WRITELN( Script_Debug_File ,
  964.                                                  '      Fixup at ', ( J ):4,
  965.                                                  ' to be ',NextP_Bytes[1]:4,
  966.                                                  NextP_Bytes[2]:4, ' = ',NextP:8 );
  967.                                      END;
  968.  
  969.                                END
  970.                             ELSE
  971.                                BEGIN
  972.                                   J := -J;
  973.                                   Script_Buffer^[ J + 5 ] := NextP_Bytes[1];
  974.                                   Script_Buffer^[ J + 6 ] := NextP_Bytes[2];
  975.                                   IF Script_Debug_Mode THEN
  976.                                      BEGIN
  977.                                         WRITELN( Script_Debug_File ,
  978.                                                  '      Fixup at ', ( J + 5 ):4,
  979.                                                  ' to be ',NextP_Bytes[1]:4,
  980.                                                  NextP_Bytes[2]:4, ' = ',NextP:8 );
  981.                                      END;
  982.  
  983.  
  984.                                END;
  985.  
  986.                                    (* Erase EndIf from buffer *)
  987.  
  988.                             Script_Buffer_Pos := Script_Buffer_Pos - 1;
  989.  
  990.                          END
  991.                       ELSE
  992.                          OK_Script_Command := FALSE;
  993.  
  994.                    END;
  995.  
  996.       KeySendSy  : BEGIN
  997.                       Get_String( Script_Line, IS, PStr, Delim );
  998.                       L := LENGTH( PStr );
  999.                       PStr := UpperCase( PStr );
  1000.                       IF ( L > 0 ) THEN
  1001.                          BEGIN
  1002.                             I := POS( PStr[1] , 'FACS' );
  1003.                             IF ( I > 0 ) THEN
  1004.                                BEGIN
  1005.                                   J := 2;
  1006.                                   Get_Integer( PStr, J, Qnum, IntVal );
  1007.                                   IF ( Qnum AND ( IntVal >= 0 ) AND
  1008.                                      ( IntVal <= 10 ) ) THEN
  1009.                                      BEGIN
  1010.                                         CASE I OF
  1011.                                            1: I := 58;
  1012.                                            2: I := 103;
  1013.                                            3: I := 93;
  1014.                                            4: I := 83;
  1015.                                         END (* Case *);
  1016.                                         ByteVal := I + IntVal;
  1017.                                         Copy_Byte_To_Buffer( ByteVal );
  1018.                                      END (* Qnum *);
  1019.                                END (* I > 0 *);
  1020.                          END (* L > 0 *);
  1021.                    END;
  1022.  
  1023.       KeyDefSy   : BEGIN
  1024.                       Get_String( Script_Line, IS, PStr, Delim );
  1025.                       L := LENGTH( PStr );
  1026.                       PStr := UpperCase( PStr );
  1027.                       IF ( L > 0 ) THEN
  1028.                          BEGIN
  1029.                             I := POS( PStr[1] , 'FACS' );
  1030.                             IF ( I > 0 ) THEN
  1031.                                BEGIN
  1032.                                   J := 2;
  1033.                                   Get_Integer( PStr, J, Qnum, IntVal );
  1034.                                   IF ( Qnum AND ( IntVal >= 0 ) AND
  1035.                                      ( IntVal <= 10 ) ) THEN
  1036.                                      BEGIN
  1037.                                         CASE I OF
  1038.                                            1: I := 58;
  1039.                                            2: I := 103;
  1040.                                            3: I := 93;
  1041.                                            4: I := 83;
  1042.                                         END (* Case *);
  1043.                                         ByteVal := I + IntVal;
  1044.                                         Copy_Byte_To_Buffer( ByteVal );
  1045.                                      END (* Qnum *);
  1046.                                END (* I > 0 *);
  1047.                          END (* L > 0 *);
  1048.                       Copy_String_To_Buffer;
  1049.                    END;
  1050.  
  1051.       WaitStrSy  : Emit_Wait_String_Command( OK_Script_Command );
  1052.  
  1053.       WhenSy     : BEGIN
  1054.                       Copy_String_To_Buffer;
  1055.                       IS := IS + 1;
  1056.                       Copy_String_To_Buffer;
  1057.                    END;
  1058.  
  1059.       ReceiveSy  : BEGIN
  1060.                       Copy_String_To_Buffer;
  1061.                       IS := IS + 1;
  1062.                       Copy_Protocol_To_Buffer;
  1063.                    END;
  1064.  
  1065.       SendSy     : BEGIN
  1066.                       Copy_String_To_Buffer;
  1067.                       IS := IS + 1;
  1068.                       Copy_Protocol_To_Buffer;
  1069.                    END;
  1070.  
  1071.       RepeatSy   : BEGIN
  1072.                                    (* Increment repeat level *)
  1073.  
  1074.                       Script_Repeat_Level := Script_Repeat_Level + 1;
  1075.  
  1076.                                    (* Remember where repeat starts. *)
  1077.  
  1078.                       Script_Repeat_Stack[Script_Repeat_Level] :=
  1079.                          Script_Buffer_Pos;
  1080.  
  1081.                                    (* Erase repeat command *)
  1082.  
  1083.                       Script_Buffer_Pos   := Script_Buffer_Pos   - 1;
  1084.  
  1085.                    END;
  1086.  
  1087.       UntilSy    : BEGIN
  1088.                       IF ( Script_Repeat_Level > 0 ) THEN
  1089.                          BEGIN
  1090.  
  1091.                                    (* Pop REPEAT address off stack *)
  1092.  
  1093.                             J := Script_Repeat_Stack[ Script_Repeat_Level ];
  1094.                             Script_Repeat_Level := Script_Repeat_Level - 1;
  1095.  
  1096.                                    (* Emit end of loop test *)
  1097.  
  1098.                             Emit_If_Command( J , OK_Script_Command );
  1099.  
  1100.                          END
  1101.                       ELSE
  1102.                          OK_Script_Command := FALSE;
  1103.                    END;
  1104.  
  1105.       WhileSy    : BEGIN
  1106.                                    (* Increment While level *)
  1107.  
  1108.                       Script_While_Level := Script_While_Level + 1;
  1109.                       Script_While_Stack[Script_While_Level] :=
  1110.                          Script_Buffer_Pos;
  1111.  
  1112.                                    (* Emit conditional command *)
  1113.  
  1114.                       Emit_If_Command( 0 , OK_Script_Command );
  1115.  
  1116.                    END;
  1117.  
  1118.       EndWhileSy : BEGIN
  1119.  
  1120.                       IF ( Script_While_Level > 0 ) THEN
  1121.                          BEGIN
  1122.  
  1123.                             J := Script_While_Stack[ Script_While_Level ];
  1124.                             Script_While_Level := Script_While_Level - 1;
  1125.  
  1126.                             Script_Buffer^[Script_Buffer_Pos] := ORD( GoToSy );
  1127.                             Copy_Integer_To_Buffer( J );
  1128.  
  1129.                             NextP := Script_Buffer_Pos + 1;
  1130.  
  1131.                             Script_Buffer^[ J + 5 ] := NextP_Bytes[1];
  1132.                             Script_Buffer^[ J + 6 ] := NextP_Bytes[2];
  1133.  
  1134.                             IF Script_Debug_Mode THEN
  1135.                                BEGIN
  1136.                                   WRITELN( Script_Debug_File ,
  1137.                                            '      Fixup at ', ( J + 5 ):4,
  1138.                                            ' to be ',NextP_Bytes[1]:4,
  1139.                                            NextP_Bytes[2]:4, ' = ',NextP:8 );
  1140.                                END;
  1141.  
  1142.                          END
  1143.                       ELSE
  1144.                          OK_Script_Command := FALSE;
  1145.  
  1146.                    END;
  1147.  
  1148.       ParamSy    : BEGIN
  1149.  
  1150.                       Get_String( Script_Line, IS, PStr, Delim );
  1151.  
  1152.                       Copy_Byte_To_Buffer( ORD( PStr[1] ) );
  1153.                       Copy_Byte_To_Buffer( ORD( PStr[2] ) );
  1154.  
  1155.                       IF Delim = '=' THEN
  1156.                          IS := IS + 1;
  1157.  
  1158.                       L                 := 0;
  1159.                       Script_Buffer_Pos := Script_Buffer_Pos + 1;
  1160.                       SvPos             := Script_Buffer_Pos;
  1161.  
  1162.                       FOR I := IS TO LENGTH( Script_Line ) DO
  1163.                          BEGIN
  1164.                             L                 := L + 1;
  1165.                             Copy_Byte_To_Buffer( ORD( Script_Line[I] ) );
  1166.                          END;
  1167.  
  1168.                       Script_Buffer^[SvPos] := L;
  1169.  
  1170.                    END;
  1171.  
  1172.       ELSE;
  1173.  
  1174.    END (* CASE *);
  1175.  
  1176. END   (* Parse_Script_Command *);
  1177.  
  1178. (*----------------------------------------------------------------------*)
  1179. (*   Fix_Label_References --- Fix up label references in script buffer  *)
  1180. (*----------------------------------------------------------------------*)
  1181.  
  1182. PROCEDURE Fix_Label_References( VAR OK_Script_Command : BOOLEAN );
  1183.  
  1184. (*----------------------------------------------------------------------*)
  1185. (*                                                                      *)
  1186. (*     Procedure:  Fix_Label_References                                 *)
  1187. (*                                                                      *)
  1188. (*     Purpose:    Fix up label references in script buffer             *)
  1189. (*                                                                      *)
  1190. (*     Calling Sequence:                                                *)
  1191. (*                                                                      *)
  1192. (*        Fix_Label_References( VAR OK_Script_Command : BOOLEAN );      *)
  1193. (*                                                                      *)
  1194. (*           OK_Script_Command --- set TRUE if fixups went OK           *)
  1195. (*                                                                      *)
  1196. (*----------------------------------------------------------------------*)
  1197.  
  1198. BEGIN (* Fix_Label_References *)
  1199.  
  1200.    OK_Script_Command := TRUE;
  1201.  
  1202. END   (* Fix_Label_References *);
  1203.  
  1204. (*----------------------------------------------------------------------*)
  1205.  
  1206. BEGIN (* Process_Script *)
  1207.  
  1208.                                    (* Save current screen *)
  1209.    Save_Screen( Local_Save );
  1210.    Draw_Menu_Frame( 10, 10, 78, 20, Menu_Frame_Color,
  1211.                     Menu_Text_Color, 'Scan script file' );
  1212.  
  1213.                                    (* Pick up script file name *)
  1214.                                    (* if not already supplied  *)
  1215.  
  1216.    IF ( LENGTH( Script_File_Name ) = 0 ) THEN
  1217.       BEGIN
  1218.          WRITE('Script file name ? ');
  1219.          READLN( Script_File_Name );
  1220.       END;
  1221.                                    (* Quit if null entry *)
  1222.  
  1223.    IF LENGTH( Script_File_Name ) <= 0 THEN
  1224.       BEGIN
  1225.          Restore_Screen( Local_Save );
  1226.          Reset_Global_Colors;
  1227.          EXIT;
  1228.       END;
  1229.                                    (* Fix up script file name *)
  1230.  
  1231.    Script_File_Name := UpperCase( Script_File_Name );
  1232.  
  1233.    IF ( POS( '.', Script_File_Name ) = 0 ) THEN
  1234.       Script_File_Name := Script_File_Name + '.SCR';
  1235.  
  1236.                                    (* See if script file exists *)
  1237.  
  1238.    ASSIGN( Byte_File , Script_File_Name );
  1239.       (*$I-*)
  1240.    RESET ( Byte_File );
  1241.       (*$I+*)
  1242.  
  1243.    IF ( Int24Result <> 0 ) THEN
  1244.       BEGIN
  1245.  
  1246.          WRITELN(' ');
  1247.          WRITELN('Script file ',Script_File_Name,' not found.');
  1248.          WRITELN(' ');
  1249.  
  1250.          Really_Wait_String  := FALSE;
  1251.          Script_Suspend_Time := 0.0;
  1252.          Script_File_Mode    := FALSE;
  1253.  
  1254.                                    (* Restore previous screen *)
  1255.          DELAY( Two_Second_Delay );
  1256.  
  1257.          Restore_Screen( Local_Save );
  1258.          Reset_Global_Colors;
  1259.                                    (* Quit now *)
  1260.          EXIT;
  1261.  
  1262.       END
  1263.    ELSE
  1264.       BEGIN
  1265.          WRITELN(' ');
  1266.          WRITELN('Beginning scan of script file ',Script_File_Name);
  1267.          WRITELN(' ');
  1268.       END;
  1269.                                    (* Get size of script file.     *)
  1270.                                    (* Allocate command buffer of   *)
  1271.                                    (* same length to hold compiled *)
  1272.                                    (* script commands.             *)
  1273.  
  1274.    Script_Buffer_Size := FileSize( Byte_File );
  1275.  
  1276.    CLOSE( Byte_File );
  1277.  
  1278.    IF ( Script_File_Name = 'ZZBOGUS.SCR' ) THEN
  1279.       BEGIN
  1280.          ASSIGN ( Script_Debug_File , 'ZZBOGUS.DBG' );
  1281.          REWRITE( Script_Debug_File );
  1282.          Script_Debug_Mode := TRUE;
  1283.       END
  1284.    ELSE
  1285.       Script_Debug_Mode := FALSE;
  1286.  
  1287.    GetMem( Script_Buffer , Script_Buffer_Size );
  1288.  
  1289.                                    (* Current offset in script buffer *)
  1290.    Script_Buffer_Pos  := 0;
  1291.                                    (* No labels yet defined         *)
  1292.    Script_Label_Count := 0;
  1293.                                    (* All stacks empty              *)
  1294.    Script_Repeat_Level := 0;
  1295.    Script_If_Level     := 0;
  1296.    Script_While_Level  := 0;
  1297.                                    (* Open script file as text file *)
  1298.  
  1299.    ASSIGN( Script_File , Script_File_Name );
  1300.       (*$I-*)
  1301.    RESET ( Script_File );
  1302.       (*$I+*)
  1303.                                    (* Read and compile lines from  *)
  1304.                                    (* script file                  *)
  1305.    REPEAT
  1306.                                    (* Read script line             *)
  1307.  
  1308.       READLN( Script_File , Script_Line );
  1309.  
  1310.       Saved_Script_Line := Script_Line;
  1311.       OK_Script_Command := TRUE;
  1312.  
  1313.                                    (* Check for serious read error *)
  1314.       IF Int24Result <> 0 THEN
  1315.          OK_Script_Command := FALSE
  1316.  
  1317.                                    (* Skip comment lines           *)
  1318.  
  1319.       ELSE IF ( LENGTH( Script_Line ) > 0 ) THEN
  1320.          IF ( Script_Line[1] <> '*' ) THEN
  1321.  
  1322.                                    (* Parse and store compiled command *)
  1323.             BEGIN
  1324.  
  1325.                IF Script_Debug_Mode THEN
  1326.                   BEGIN
  1327.                      WRITELN( Script_Debug_File , '--- next statement --- ' );
  1328.                      WRITELN( Script_Debug_File , '<', Script_Line, '>' );
  1329.                      WRITELN( Script_Debug_File , '--- ');
  1330.                   END;
  1331.  
  1332.                Extract_Script_Command( OK_Script_Command );
  1333.  
  1334.                IF OK_Script_Command THEN
  1335.                   Parse_Script_Command  ( OK_Script_Command );
  1336.  
  1337.                IF ( NOT Ok_Script_Command ) THEN
  1338.                   BEGIN
  1339.  
  1340.                      WRITELN('>>> Error in the following script line: ');
  1341.                      WRITELN( Saved_Script_Line );
  1342.  
  1343.                      WRITE('Hit any key to continue ... ');
  1344.  
  1345.                      READ( Kbd, Ch );
  1346.  
  1347.                      IF ( ORD( Ch ) = ESC ) AND KeyPressed THEN
  1348.                         READ( Kbd, Ch );
  1349.  
  1350.                   END;
  1351.  
  1352.          END;
  1353.  
  1354.    UNTIL ( EOF( Script_File ) OR ( NOT OK_Script_Command ) );
  1355.  
  1356.                                    (* Close script file.             *)
  1357.       (*$I-*)
  1358.    CLOSE( Script_File );
  1359.       (*$I+*)
  1360.  
  1361.    I := Int24Result;
  1362.                                    (* Drop "finish script" command   *)
  1363.                                    (* into script buffer.            *)
  1364.  
  1365.    IF Script_Debug_Mode THEN
  1366.       WRITELN( Script_Debug_File , '--- Exit statement follows ... ');
  1367.  
  1368.    Copy_Byte_To_Buffer( ORD( ExitSy ) );
  1369.  
  1370.                                    (* Check if stacks empty.  If not,  *)
  1371.                                    (* error from unclosed loop.        *)
  1372.  
  1373.    OK_Script_Command := OK_Script_Command           AND
  1374.                         ( Script_Repeat_Level = 0 ) AND
  1375.                         ( Script_If_Level     = 0 ) AND
  1376.                         ( Script_While_Level  = 0 );
  1377.  
  1378.                                    (* Fix up label references          *)
  1379.    IF OK_Script_Command THEN
  1380.       Fix_Label_References( OK_Script_Command );
  1381.  
  1382.                                    (* Now point to start of buffer     *)
  1383.    Script_Buffer_Pos := 0;
  1384.                                    (* If everything OK, allow script   *)
  1385.                                    (* to execute, else release buffer. *)
  1386.    Really_Wait_String  := FALSE;
  1387.    Script_Suspend_Time := 0.0;
  1388.  
  1389.    IF OK_Script_Command THEN
  1390.       BEGIN
  1391.          Script_File_Mode   := TRUE;
  1392.          WRITELN('Script file OK.');
  1393.       END
  1394.    ELSE
  1395.       BEGIN
  1396.          WRITELN('Script file will not be executed.');
  1397.          Script_File_Mode   := FALSE;
  1398.          FREEMEM( Script_Buffer , Script_Buffer_Size );
  1399.       END;
  1400.                                    (* Restore previous screen *)
  1401.    DELAY( Two_Second_Delay );
  1402.  
  1403.    Restore_Screen( Local_Save );
  1404.    Reset_Global_Colors;
  1405.  
  1406.    IF Script_Debug_Mode THEN
  1407.       CLOSE( Script_Debug_File );
  1408.  
  1409. END   (* Process_Script *);
  1410.